home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #097 (1990-10)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #097 (1990-10)(Amiga User Group Deutschland e.V.).adf / Moire / Moire.MOD < prev    next >
Text File  |  1990-09-11  |  3KB  |  119 lines
  1. (* Moire - wurde im Jahre 1990 von Marcus Schießer geschrieben
  2.    Moire ist Freeware. Das Kopierrecht liegt allein beim Autor
  3.    Das Programm zeichnet ein sogenanntes Moire-Gitter.          *)
  4.  
  5. MODULE Moire;
  6.  
  7. FROM Arts IMPORT
  8.   Assert,TermProcedure;
  9. FROM Exec IMPORT
  10.   SetSignal;
  11. FROM SYSTEM IMPORT
  12.   ADR,ADDRESS,LONGSET,INLINE,SETREG;
  13. FROM Graphics IMPORT
  14.   RastPortPtr,jam1,Move,Draw,SetAPen,SetDrMd,
  15.   ViewModes,ViewModeSet,LoadRGB4,ViewPortPtr;
  16. FROM Intuition IMPORT
  17.   customScreen,IDCMPFlags,IDCMPFlagSet,NewScreen,NewWindow,
  18.   ScreenFlags,ScreenFlagSet,ScreenPtr,WindowFlags,WindowFlagSet,
  19.   WindowPtr,CloseScreen,CloseWindow,OpenScreen,OpenWindow,ShowTitle;
  20. FROM RandomNumber IMPORT
  21.   RND;
  22. FROM Dos IMPORT
  23.   Delay;
  24.  
  25. CONST
  26.   Height= 256;
  27.   Width= 640;
  28.  
  29. VAR
  30.   MyScreen: ScreenPtr;
  31.   MyWindow: WindowPtr;
  32.   MyRP: RastPortPtr;
  33.   LoopNumber,XNumber,YNumber: CARDINAL;
  34.  
  35. PROCEDURE Cleanup;
  36. BEGIN
  37.   IF MyWindow#NIL THEN
  38.     CloseWindow(MyWindow);
  39.   END;
  40.   IF MyScreen#NIL THEN
  41.     CloseScreen(MyScreen);
  42.   END;
  43. END Cleanup;
  44.  
  45. PROCEDURE DrawLine(x1,y1,x2,y2,color: INTEGER);
  46. BEGIN
  47.   SetAPen(MyRP,color);
  48.   SetDrMd(MyRP,jam1);
  49.   Move(MyRP,x1,y1);
  50.   Draw(MyRP,x2,y2);
  51. END DrawLine;
  52.  
  53. PROCEDURE colors; (*$E-*)
  54. BEGIN
  55.   INLINE(0000H,0FFFH);
  56. END colors;
  57.  
  58. PROCEDURE CreateScreen(w,h,d: INTEGER; t: ADDRESS): ScreenPtr;
  59. VAR
  60.   ns: NewScreen;
  61. BEGIN
  62.   WITH ns DO
  63.     leftEdge:=0;topEdge:=0;width:=w;height:=h;depth:=d;
  64.     detailPen:=0;blockPen:=1;
  65.     viewModes:=ViewModeSet{hires};
  66.     type:=customScreen;
  67.     font:=NIL;
  68.     defaultTitle:=t;
  69.     gadgets:=NIL;
  70.     customBitMap:=NIL;
  71.   END;
  72.   RETURN OpenScreen(ns);
  73. END CreateScreen;
  74.  
  75. PROCEDURE CreateWindow(x,y,w,h: INTEGER; if: IDCMPFlagSet; wf: WindowFlagSet;
  76.                g,s,t: ADDRESS): WindowPtr;
  77. VAR
  78.   nw: NewWindow;
  79. BEGIN
  80.   WITH nw DO
  81.     leftEdge:=x;topEdge:=y;width:=w;height:=h;detailPen:=0;blockPen:=1;
  82.     idcmpFlags:=if;flags:=wf;firstGadget:=g;checkMark:=NIL;
  83.     title:=t;screen:=s;bitMap:=NIL;minWidth:=w;minHeight:=h;
  84.     maxWidth:=w;maxHeight:=h;type:=customScreen;
  85.   END;
  86.   RETURN OpenWindow(nw);
  87. END CreateWindow;
  88.  
  89. BEGIN
  90.   MyWindow:=NIL; MyScreen:=NIL;
  91.   TermProcedure(Cleanup);
  92.   MyScreen:=CreateScreen(640,256,1,NIL);
  93.   Assert(MyScreen#NIL,ADR("Cannot open the screen"));
  94.   SETREG(0,0);
  95.   ShowTitle(MyScreen,FALSE);
  96.   MyWindow:=CreateWindow(0,0,640,256,
  97.                IDCMPFlagSet{mouseButtons},
  98.                WindowFlagSet{borderless,backDrop,activate},
  99.                NIL,MyScreen,NIL);
  100.   Assert(MyWindow#NIL,ADR("Cannot open the window"));
  101.   MyRP:=MyWindow^.rPort;
  102.   LoadRGB4(ADR(MyScreen^.viewPort),ADR(colors),4);
  103.  
  104.   WHILE NOT (MyWindow^.userPort^.sigBit IN SetSignal(LONGSET{},LONGSET{})) DO
  105.     XNumber:=1+RND(Width);
  106.     YNumber:=1+RND(Height);
  107.     FOR LoopNumber := 1 TO Height DO
  108.       DrawLine(XNumber,YNumber,1,LoopNumber,(LoopNumber MOD 2)+1);
  109.       DrawLine(XNumber,YNumber,Width,LoopNumber,(LoopNumber MOD 2)+1);
  110.     END;
  111.     FOR LoopNumber := 1 TO Width DO
  112.       DrawLine(XNumber,YNumber,LoopNumber,1,(LoopNumber MOD 2)+1);
  113.       DrawLine(XNumber,YNumber,LoopNumber,Height,(LoopNumber MOD 2)+1);
  114.     END;
  115.     Delay(100);
  116.   END;
  117.  
  118. END Moire.
  119.